home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / hypercrd / xcmd / dxcmds34.sit / Dartmouth XCMD's 3.4.3 / card_18192.txt < prev    next >
Text File  |  1990-04-17  |  12KB  |  346 lines

  1. -- card: 18192 from stack: in.3
  2. -- bmap block id: 0
  3. -- flags: 4000
  4. -- background id: 3241
  5. -- name: Password
  6. ----- HyperTalk script -----
  7. on Install
  8.   get ChooseTargetStack()
  9.   InstallResource XFCN,Password,it
  10. end Install
  11.  
  12.  
  13. -- part 1 (button)
  14. -- low flags: 00
  15. -- high flags: A003
  16. -- rect: left=80 top=300 right=322 bottom=180
  17. -- title width / last selected line: 0
  18. -- icon id / first selected line: 0 / 0
  19. -- text alignment: 1
  20. -- font id: 0
  21. -- text size: 12
  22. -- style flags: 0
  23. -- line height: 16
  24. -- part name: Try It
  25. ----- HyperTalk script -----
  26. on mouseUp
  27.   put Password()
  28. end mouseUp
  29.  
  30.  
  31.  
  32. -- part 2 (field)
  33. -- low flags: 81
  34. -- high flags: 2007
  35. -- rect: left=12 top=26 right=298 bottom=491
  36. -- title width / last selected line: 0
  37. -- icon id / first selected line: 0 / 0
  38. -- text alignment: 0
  39. -- font id: 22
  40. -- text size: 10
  41. -- style flags: 0
  42. -- line height: 13
  43. -- part name: Source
  44.  
  45.  
  46. -- part 3 (button)
  47. -- low flags: 00
  48. -- high flags: A003
  49. -- rect: left=299 top=300 right=322 bottom=438
  50. -- title width / last selected line: 0
  51. -- icon id / first selected line: 0 / 0
  52. -- text alignment: 1
  53. -- font id: 0
  54. -- text size: 12
  55. -- style flags: 0
  56. -- line height: 16
  57. -- part name: Show Pascal Source
  58. ----- HyperTalk script -----
  59. on mouseUp
  60.   set the visible of card field 1 to not the visible of card field 1
  61.   if the visible of card field 1 is true then
  62.     set the name of me to "Hide Pascal Source"
  63.   else set the name of me to "Show Pascal Source"
  64. end mouseUp
  65.  
  66.  
  67.  
  68. -- part contents for background part 16
  69. ----- text -----
  70. PASSWORD XFCN version 1.0.1
  71. Kevin Calhoun
  72.  
  73. Password behaves in almost the same way as the HyperTalk command "ask password".  It differs in that it is capable of distinguishing between upper- and lower-case characters and in that it displays bullets in the ask dialog box instead of the actual password.  This is useful if you want to hide what you type from your little brother, your boss, or your archrival in software development.  
  74.  
  75. Password returns a number which it derives from the password that's entered.  This number can be stored in a field to be compared with the result of a subsequent call to Password if, for example, you want the user to be able to protect data contained in the stack.  Given a ne'er-do-well with access to enough CPU time or a whiz at 68000 opcodes with a good disassembler, it's not difficult to imagine that the encryption scheme that Password employs can be broken.  Use it only if your little brother, boss, or archrival in software development has better things to do than to hack your stack.
  76.  
  77. Note that the number returned by Password for a particular string is not the same as the number returned for that string by the HyperTalk command "ask password".
  78.  
  79. INVOKING PASSWORD
  80.  
  81. get Password(<"prompt">,<caseSensitive>)
  82.  
  83. result:  a number
  84.  
  85. If parameter 1 is present, it becomes the prompt string that appears in the same place as a question that's passed to the HyperTalk command ask.  If parameter 1 is not present, Password uses the prompt, "Please enter your password:". 
  86.  
  87. If caseSensitive is TRUE, then Password distinguishes between upper- and lower-case characters when encrypting the password.  If it is absent, or it is anything other than TRUE, Password does not distinguish between upper- and lower-case characters.
  88.  
  89. If an error occurs, Password returns a string, the first word of which will be "Error".  If the user clicks the Cancel button, Password returns "Cancel".  If the user types nothing before clicking the OK button, Password returns 0.
  90.  
  91. My thanks to Jim Matthews for the filter function that handles the bullets.
  92.  
  93. Revision history:
  94. 15 March 1989 -- first release.
  95. 11 June 1989 -- Changed the way the prompt message is set for compatibility with SuperCard.  (No longer use ParamText.  Use SetIText instead.)
  96.  
  97. -- part contents for card part 2
  98. ----- text -----
  99. UNIT PasswordUnit;
  100.  
  101. { This source compatible with MPW Pascal 3.0 }
  102.  
  103. { Password XFCN ┬⌐1989 by the Trustees of Dartmouth College }
  104. { Written by Kevin Calhoun }
  105.  
  106. (*
  107. Pascal Password.p
  108. Link -m ENTRYPOINT Γêé
  109.      -o "YourFile" Γêé
  110.      -rt XFCN=17958 Γêé
  111.      -sn Main=Password Γêé
  112.      Password.p.o Γêé
  113.     "{Libraries}"interface.o Γêé
  114.     "{PLibraries}"Paslib.o Γêé
  115.     "{Libraries}"HyperXLib.o
  116. *)
  117.  
  118. {$R-}
  119.  
  120. INTERFACE
  121.   USES
  122.     Types,
  123.     Memory,
  124.     Resources,
  125.     Dialogs,
  126.     ToolUtils,
  127.     OSUtils,
  128.     HyperXCmd;
  129.  
  130.   PROCEDURE Entrypoint (paramPtr : XCmdPtr);
  131.  
  132. IMPLEMENTATION
  133.  
  134.   PROCEDURE DoPassword(paramPtr: XCMDPtr); FORWARD;
  135.  
  136.   PROCEDURE Entrypoint(paramPtr: XCMDPtr);
  137.   BEGIN
  138.     DoPassword(paramPtr);
  139.   END;
  140.   
  141.   FUNCTION GetScreenBitsBounds: Rect;
  142.   { get screenbits.bounds from the QuickDraw globals }
  143.   TYPE
  144.     LongwordPtr = ^LONGINT;
  145.     BitMapPtr = ^BitMap;
  146.   CONST
  147.     screenBitsOffset = -122;
  148.     CurrentA5 = $904;
  149.   VAR
  150.     screenBitsPtr : BitMapPtr;
  151.     myLongwordPtr : LongwordPtr;
  152.   BEGIN
  153.     myLongwordPtr := LongwordPtr(CurrentA5);
  154.       { myLongwordPtr now points to the pointer to the first QD global }
  155.     myLongwordPtr := LongwordPtr(myLongwordPtr^);
  156.       { myLongwordPtr now points to the first QD global }
  157.     screenBitsPtr := BitMapPtr(myLongwordPtr^ + screenBitsOffset);
  158.       { screenBitsPtr now points to the screenBits BitMap }
  159.     GetScreenBitsBounds := screenBitsPtr^.bounds;
  160.   END;
  161.     
  162.   PROCEDURE CenterRectH(var r: Rect; inRect: Rect);
  163.     var hOffset: INTEGER;
  164.   BEGIN
  165.     hOffset := ((inRect.right - inRect.left) - (r.right - r.left)) div 2;
  166.     OffsetRect(r, -r.left, 0);
  167.     OffsetRect(r, hOffset, 0);
  168.   END;
  169.  
  170.   FUNCTION Encrypt(s: Str255): LONGINT;
  171.     var
  172.       numChars: INTEGER;
  173.       checkSum: LONGINT;
  174.       i: INTEGER;
  175.   BEGIN
  176.     numChars := LENGTH(s);
  177.     checkSum := 0;
  178.     i := 1;
  179.     while i <= numChars do
  180.       begin
  181.       checkSum := checkSum + ORD(s[i]);
  182.       i := i+1;
  183.       end;
  184.     if numChars > 0 then
  185.       for i := 1 to 10 do
  186.         checkSum := (checkSum * 16381 + 17) mod 32761 + 1;
  187.     Encrypt := checkSum;
  188.   END;
  189.  
  190.   PROCEDURE PassReturnValue (paramPtr: XCMDPtr; s : Str255); { set theResult }
  191.   BEGIN
  192.     paramPtr^.returnValue := PasToZero(paramPtr, s);
  193.   END;
  194.  
  195.   { signonFilter -- dialog filter for doSignon, hides password }
  196.   FUNCTION SignonFilter (dp : DialogPtr;
  197.               VAR theEvent : EventRecord;
  198.               VAR itemHit : integer) : boolean;
  199.       CONST
  200.           nameItem = 3;
  201.           passwordItem = 4;
  202.           bs = $08;
  203.           tab = $09;
  204.           cr = $0D;
  205.           enter = $03;
  206.           larrow = $1C;
  207.           rarrow = $1D;
  208.           uparrow = $1E;
  209.           downarrow = $1F;
  210.       VAR
  211.           dpeek : DialogPeek;
  212.           theChar : char;
  213.           theStr : Str255;
  214.           selStart, selEnd : integer;
  215.           h : Handle;
  216.           itemType : integer;
  217.           box : Rect;
  218.           pwStr : StringPtr;
  219.   BEGIN
  220.       pwStr := StringPtr(GetWRefCon(dp));
  221.       signonFilter := false;
  222.       dpeek := DialogPeek(dp);
  223.       IF ((theEvent.what = keydown) OR (theEvent.what = autoKey)) THEN
  224.           BEGIN
  225.               theChar := char(BitAnd(theEvent.message, charCodeMask));
  226.               selStart := dpeek^.textH^^.selStart;
  227.               selEnd := dpeek^.textH^^.selEnd;
  228.               CASE ord(theChar) OF
  229.                   bs :                { Backspace }
  230.                       BEGIN
  231.                           IF selEnd = selStart THEN  { back over a character }
  232.                           BEGIN
  233.                               IF selStart > 0 THEN
  234.                                   pwStr^ := concat(copy(pwStr^,1, selStart - 1),
  235.                                                     copy(pwStr^, selStart + 1,
  236.                                                      length(pwStr^) - selStart));
  237.                           END
  238.                           ELSE            { delete the selection }
  239.                               pwStr^ := concat(copy(pwStr^, 1, selStart),
  240.                                copy(pwStr^, selEnd + 1, length(pwStr^) - selEnd));
  241.                       END;
  242.                   cr, enter :     { Return or Enter -- treat as "OK }
  243.                       BEGIN
  244.                           itemHit := ok;
  245.                           signonFilter := true;
  246.                       END; { cr, enter }
  247.                   tab, uparrow, downarrow, rarrow, larrow :
  248.                       ;        { just pass on tabs & arrows }
  249.                   OTHERWISE   { "normal" character }
  250.                       BEGIN        { remember character, insert a bullet }
  251.                           pwStr^ := concat(copy(pwStr^, 1, selStart), theChar,
  252.                            copy(pwStr^, selEnd + 1, length(pwStr^) - selEnd));
  253.                           theEvent.message := BitAnd(theEvent.message, $FFFFFF00) + ord('ΓÇó');
  254.                       END; { normal character }
  255.               END; { case ord(theChar) of }
  256.           END { in password field }
  257.           ELSE     { not in password field -- still check for cr, enter }
  258.               CASE BitAnd(theEvent.message, charCodeMask) OF
  259.                   cr, enter :
  260.                       BEGIN
  261.                           itemHit := ok;
  262.                           signonFilter := true;
  263.                       END; { cr, enter }
  264.                   OTHERWISE
  265.                       ;
  266.               END; { case BitAnd }
  267.   END; { signonFilter }
  268.   
  269.   PROCEDURE DoPassword(paramPtr: XCMDPtr);
  270.     const statTextItem = 3;
  271.     var
  272.       dlgTHndl: Handle;
  273.       hndl: Handle;
  274.       id: INTEGER;
  275.       rType: ResType;
  276.       s: Str255;
  277.       prompt: Str255;
  278.       pwStr: Str255;
  279.       itemHit: INTEGER;
  280.       d: DialogPtr;
  281.       kind: INTEGER;
  282.       r: Rect;
  283.       saveRect: Rect;
  284.       saveVis: BOOLEAN;
  285.       flag: BOOLEAN;
  286.       myLongint : LONGINT;
  287.       err: OSErr;
  288.   BEGIN
  289.     pwStr := '';
  290.     dlgTHndl := GetNamedResource('DLOG', 'Ask');
  291.     err := ResError;
  292.     if (dlgTHndl <> nil) and (err = noErr) then
  293.       begin
  294.       HNoPurge(dlgTHndl);
  295.       GetResInfo(dlgTHndl, id, rType, s);
  296.       if paramPtr^.paramCount > 0 then ZeroToPas(paramPtr, paramPtr^.params[1]^, prompt)
  297.       else prompt := 'Please enter your password:';
  298.       r := DialogTHndl(dlgTHndl)^^.boundsRect; { get DLOG boundsRect}
  299.       CenterRectH(r, GetScreenBitsBounds);
  300.       saveRect := DialogTHndl(dlgTHndl)^^.boundsRect;
  301.       DialogTHndl(dlgTHndl)^^.boundsRect := r;
  302.       saveVis := DialogTHndl(dlgTHndl)^^.visible;
  303.       DialogTHndl(dlgTHndl)^^.visible := FALSE;
  304.       d := GetNewDialog(id, nil, POINTER(-1));
  305.       GetDItem(d, statTextItem, kind, hndl, r);
  306.       IF (kind MOD itemDisable = statText) THEN SetIText(hndl,prompt);
  307.       SetWRefCon(d, LONGINT(@pwStr));
  308.       ShowWindow(d);
  309.       BringToFront(d);
  310.       SetPort(d);
  311.       GetDItem(d, 1, kind, hndl, r);
  312.       InsetRect(r,-4,-4);
  313.       PenSize(3,3);
  314.       FrameRoundRect(r,16,16);
  315.       PenSize(1,1);
  316.       repeat
  317.         ModalDialog(@SignonFilter, itemHit);
  318.       until (itemHit = OK) or (itemHit = Cancel);
  319.       DialogTHndl(dlgTHndl)^^.boundsRect := saveRect;
  320.       DialogTHndl(dlgTHndl)^^.visible := saveVis;
  321.       HPurge(dlgTHndl);
  322.       DisposDialog(d);
  323.       if itemHit = Cancel then PassReturnValue(paramPtr, 'Cancel')
  324.       else
  325.         begin
  326.         if paramPtr^.paramCount > 1 then
  327.           begin
  328.           ZeroToPas(paramPtr, paramPtr^.params[2]^, s);
  329.           flag := FALSE;
  330.           flag := StrToBool(paramPtr, s);
  331.           if (paramPtr^.result <> noErr) or not flag then UprString(pwStr,TRUE);
  332.           end
  333.         else UprString(pwStr,TRUE);
  334.         myLongint := Encrypt(pwStr);
  335.         NumToStr(paramPtr, myLongint, s);
  336.         PassReturnValue(paramptr, s);
  337.         end;
  338.       end
  339.     else
  340.       begin
  341.       NumToStr(paramPtr, err, s);
  342.       PassReturnValue(paramPtr, CONCAT('Error ', s));
  343.       end;
  344.   END;
  345.  
  346. END.